Setup
Versioning
Last updated on 2025-Mar-03 at 03:45 PM.
- 2025-Feb-06: Created git & RStudio project.
- 2025-Feb-11: Added individual plots.
- 2025-Feb-18: Added cleaned up data and placeholder for global sensitivity indices.
- 2025-Feb-19: Added Bland-Altman plots for MD & PSD and scatterplots for pointwise sensitivity data. Also separated individual plots into tabs.
- 2025-Feb-20: Tabs were messing up slickR javascript. Removed for now.
- 2025-Feb-24: Added section for test duration.
- 2025-Feb-27: Added section for reliability indices.
- 2025-Mar-01: Added boxplots for FP, FN, and FL.
Acknowledgements
Data collected by Research Assistant Reann Post and Research Coordinator Lynn Murphy.
# load packages
library(tidyverse)
## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.1.4 ✔ readr 2.1.5
## ✔ forcats 1.0.0 ✔ stringr 1.5.1
## ✔ ggplot2 3.5.1 ✔ tibble 3.2.1
## ✔ lubridate 1.9.4 ✔ tidyr 1.3.1
## ✔ purrr 1.0.4
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
library(here)
## here() starts at /Users/eadie/EadieTech/retinalogik-study
library(DT)
library(plotly)
##
## Attaching package: 'plotly'
##
## The following object is masked from 'package:ggplot2':
##
## last_plot
##
## The following object is masked from 'package:stats':
##
## filter
##
## The following object is masked from 'package:graphics':
##
## layout
library(viridis)
## Loading required package: viridisLite
library(svglite)
library(htmltools)
library(gridExtra)
##
## Attaching package: 'gridExtra'
##
## The following object is masked from 'package:dplyr':
##
## combine
sessionInfo()
## R version 4.4.2 (2024-10-31)
## Platform: aarch64-apple-darwin20
## Running under: macOS Ventura 13.7.1
##
## Matrix products: default
## BLAS: /Library/Frameworks/R.framework/Versions/4.4-arm64/Resources/lib/libRblas.0.dylib
## LAPACK: /Library/Frameworks/R.framework/Versions/4.4-arm64/Resources/lib/libRlapack.dylib; LAPACK version 3.12.0
##
## locale:
## [1] en_US.UTF-8/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/en_US.UTF-8
##
## time zone: America/Halifax
## tzcode source: internal
##
## attached base packages:
## [1] stats graphics grDevices utils datasets methods base
##
## other attached packages:
## [1] gridExtra_2.3 htmltools_0.5.8.1 svglite_2.1.3 viridis_0.6.5
## [5] viridisLite_0.4.2 plotly_4.10.4 DT_0.33 here_1.0.1
## [9] lubridate_1.9.4 forcats_1.0.0 stringr_1.5.1 dplyr_1.1.4
## [13] purrr_1.0.4 readr_2.1.5 tidyr_1.3.1 tibble_3.2.1
## [17] ggplot2_3.5.1 tidyverse_2.0.0
##
## loaded via a namespace (and not attached):
## [1] sass_0.4.9 generics_0.1.3 stringi_1.8.4 hms_1.1.3
## [5] digest_0.6.37 magrittr_2.0.3 evaluate_1.0.3 grid_4.4.2
## [9] timechange_0.3.0 fastmap_1.2.0 rprojroot_2.0.4 jsonlite_1.9.0
## [13] httr_1.4.7 scales_1.3.0 lazyeval_0.2.2 jquerylib_0.1.4
## [17] cli_3.6.4 rlang_1.1.5 munsell_0.5.1 withr_3.0.2
## [21] cachem_1.1.0 yaml_2.3.10 tools_4.4.2 tzdb_0.4.0
## [25] colorspace_2.1-1 vctrs_0.6.5 R6_2.6.1 lifecycle_1.0.4
## [29] htmlwidgets_1.6.4 pkgconfig_2.0.3 pillar_1.10.1 bslib_0.9.0
## [33] gtable_0.3.6 glue_1.8.0 data.table_1.17.0 systemfonts_1.2.1
## [37] xfun_0.51 tidyselect_1.2.1 rstudioapi_0.17.1 knitr_1.49
## [41] rmarkdown_2.29 compiler_4.4.2
# default chunk options
knitr::opts_chunk$set(
comment = '>', cache = TRUE, collapse = TRUE, cache = FALSE, dev= c("png")
)
# load processed data
load(here("dBdat.Rda"))
Study summary
We compared 24-2 visual field (VF) test results between Retinalogik and the Humphrey Field Analyzer (HFA) using SITA Standard test strategy in patients with early glaucoma and moderate to advanced glaucoma.
Methods (briefly)
Subjects
Eligible participants were identified among patients of Dr. Brennan Eadie at the Eadie Eye Centre. If deemed eligible for the study, subjects were recruited consecutively.
Each participant underwent five study visits. At each visit, they performed a VF test on both eyes using two devices. The order of device tested was randomized at the first (baseline) study visit.
Exclusion criteria were:
- age <18years
- diagnosis of secondary glaucoma
- diagnosis of non-glaucomatous optic neuropathy
- significant media opacity
- previous intraocular surgery
- pregnancy
- seizure disorder
- cardiac pacemaker or other implantable device
- severe vertigo or balance disturbance
- inability to demonstrate competence to make an informed decision regarding study participation
As a product of recruiting largely from the clinical service, nearly all patients had previously performed standard au- tomated perimetry.
The study adhered to the tenets of the Declaration of Helsinki for research involving human subjects and the protocol was approved by the Nova Scotia Health Research Ethics Board (#1030608). All participants gave their written informed consent before enrollment in the study.
Analysis
All OS data will be transposed to OD format before analyses. 51 eyes from 11 participants (8 females, 3 males) aged 44 to 76 (M = 65.14, SD = 8.68) were included in the analysis.
Results
Reliability indices
Reliability indices such as fixation losses (FL), false-positives (FP), and false-negatives (FN) were extracted for analysis.
library(rempsyc)
> Suggested APA citation: Thériault, R. (2023). rempsyc: Convenience functions for psychology.
> Journal of Open Source Software, 8(87), 5466. https://doi.org/10.21105/joss.05466
library(report)
reliabilityDat <- dBdat %>%
group_by(device) %>%
distinct(id, visit, eye, fpPerc, fnPerc, flPerc)
# descriptive stats
descriptive.data <- reliabilityDat %>%
group_by(device) %>%
summarize(across(fpPerc:flPerc,
list(m = mean, sd = sd),
.names = "{.col}.{.fn}"
))
reliabilityDat %>%
group_by(device) %>%
summarize(across(fpPerc:flPerc,
list(~ str_c(round(mean(.), 2), " (", round(sd(.), 2), ")")))) %>%
rename("Device" = device, "FP (SD)" = fpPerc_1, "FN (SD)" = fnPerc_1, "FL (SD)" = flPerc_1) %>%
nice_table(note = c("Shown are the mean percentages and standard deviation (SD) for each device."))Device | FP (SD) | FN (SD) | FL (SD) |
|---|---|---|---|
hfa | 5 (5.46) | 3.47 (4.76) | 25.53 (32.3) |
retinalogik | 3.12 (2.27) | 7.59 (15.02) | 1.14 (2.19) |
Note. Shown are the mean percentages and standard deviation (SD) for each device. | |||
# fpTest <- wilcox.test(fpPerc ~ device, data = reliabilityDat)
# fpTest <- t.test(fpPerc ~ device, data = reliabilityDat)
#
# fnTest <- wilcox.test(fnPerc ~ device, data = reliabilityDat)
# flTest <- wilcox.test(flPerc ~ device, data = reliabilityDat)
#
# stats.table <- report(fpTest)
# nice_table(fpTest, report = "t.test")
# t.test(flPerc ~ device, data = reliabilityDat, na.action = na.omit)
False Positives
library(hrbrthemes)
library(viridis)
fpPlot <- reliabilityDat %>%
ggplot( aes(x=device, y=fpPerc, fill=device, label=paste(id, visit, eye))) +
geom_boxplot() +
scale_fill_viridis(discrete = TRUE, alpha=0.6) +
geom_jitter(color="black", size=0.4, alpha=0.9) +
xlab("Device") +
ylab("False Positives (%)") +
theme_bw() +
theme(legend.position="none")
ggplotly(fpPlot)False Negatives
fnPlot <- reliabilityDat %>%
ggplot( aes(x=device, y=fnPerc, fill=device, label=paste(id, visit, eye))) +
geom_boxplot() +
scale_fill_viridis(discrete = TRUE, alpha=0.6) +
geom_jitter(color="black", size=0.4, alpha=0.9) +
xlab("Device") +
ylab("False Negatives (%)") +
theme_bw() +
theme(legend.position="none")
ggplotly(fnPlot)Fixation Losses
flPlot <- reliabilityDat %>%
ggplot( aes(x=device, y=flPerc, fill=device, label=paste(id, visit, eye))) +
geom_boxplot() +
scale_fill_viridis(discrete = TRUE, alpha=0.6) +
geom_jitter(color="black", size=0.4, alpha=0.9) +
xlab("Device") +
ylab("Fixation Losses (%)") +
theme_bw() +
theme(legend.position="none")
ggplotly(flPlot)Individual plots
Swipe/scroll from right to left or click on the arrows for subsequent visits. Currently not plotting RL05 data where patient withdrew from the study. Also not plotting where only HFA/Retinalogik data is available (e.g. RL04).
RL01
library(ggplot2)
library(slickR)
# make sure coordinates are numeric, then flip OS to OD for plotting purposes
dBdat %<>%
mutate(x = as.numeric(x), y = as.numeric(y)) %>%
mutate(x = case_when(
eye == "L" & device == "hfa" ~ x*-1,
TRUE ~ as.numeric(x)))
dBdat %>%
mutate(dB = as.numeric(dB)) %>%
filter(device == "hfa" & id == "RL01") %>%
group_by(id, visit, eye) %>%
arrange(id, visit, eye) %>%
# Use the group_by %>% nest pattern to group data by id
nest() %>%
# Use map2 so the id can be used as the title
mutate(graphs = map2(data, id,
~ggplot(data = .x, aes(x, y, dB)) +
geom_raster(aes(x = x, y = y, fill = dB)) +
geom_text(aes(label = dB, x = x, y = y), size = 8) +
coord_fixed(ratio = 1) +
scale_fill_gradientn(colours = viridis(47), limits = c(-1, 46),
na.value="darkred") +
theme_bw() +
ggtitle(paste0("HFA ", id, " Visit ", visit, " Eye: ", eye))
)
) %>%
# pull is the pipe-able equivalent of .[['graphs']]
pull(graphs) %>%
# Return the svg of graphs
map(function(gr) svglite::xmlSVG(show(gr), standalone = TRUE)) ->
hfa_individual_graphs
dBdat %>%
mutate(dB = as.numeric(dB)) %>%
filter(device == "retinalogik" & id == "RL01") %>%
group_by(id, visit, eye) %>%
arrange(id, visit, eye) %>%
# Use the group_by %>% nest pattern to group data by id
nest() %>%
# Use map2 so the id can be used as the title
mutate(graphs = map2(data, id,
~ggplot(data = .x, aes(x, y, dB)) +
geom_raster(aes(x = x, y = y, fill = dB)) +
geom_text(aes(label = dB, x = x, y = y), size = 8) +
coord_fixed(ratio = 1) +
scale_fill_gradientn(colours = viridis(47), limits = c(-1, 46),
na.value="darkred") +
theme_bw() +
ggtitle(paste0("Retinalogik ", id, " Visit ", visit, " Eye: ", eye))
)
) %>%
# pull is the pipe-able equivalent of .[['graphs']]
pull(graphs) %>%
# Return the svg of graphs
map(function(gr) svglite::xmlSVG(show(gr), standalone = TRUE)) ->
rt_individual_graphs
# carousels
hfa_plots <- slickR(hfa_individual_graphs, height = 350, width = "95%", padding = 0, slideId = "slick1") +
settings(slidesToShow = 2, slidesToScroll = 2)
rt_plots <- slickR(rt_individual_graphs, height = 350, width = "95%", padding = 0, slideId = "slick2") +
settings(slidesToShow = 2, slidesToScroll = 2)
rt_plots %synch% hfa_plots RL02
dBdat %>%
mutate(dB = as.numeric(dB)) %>%
filter(device == "hfa" & id == "RL02") %>%
group_by(id, visit, eye) %>%
arrange(id, visit, eye) %>%
# Use the group_by %>% nest pattern to group data by id
nest() %>%
# Use map2 so the id can be used as the title
mutate(graphs = map2(data, id,
~ggplot(data = .x, aes(x, y, dB)) +
geom_raster(aes(x = x, y = y, fill = dB)) +
geom_text(aes(label = dB, x = x, y = y), size = 8) +
coord_fixed(ratio = 1) +
scale_fill_gradientn(colours = viridis(47), limits = c(-1, 46),
na.value="darkred") +
theme_bw() +
ggtitle(paste0("HFA ", id, " Visit ", visit, " Eye: ", eye))
)
) %>%
# pull is the pipe-able equivalent of .[['graphs']]
pull(graphs) %>%
# Return the svg of graphs
map(function(gr) svglite::xmlSVG(show(gr), standalone = TRUE)) ->
hfa_individual_graphs
dBdat %>%
mutate(dB = as.numeric(dB)) %>%
filter(device == "retinalogik" & id == "RL02") %>%
group_by(id, visit, eye) %>%
arrange(id, visit, eye) %>%
# Use the group_by %>% nest pattern to group data by id
nest() %>%
# Use map2 so the id can be used as the title
mutate(graphs = map2(data, id,
~ggplot(data = .x, aes(x, y, dB)) +
geom_raster(aes(x = x, y = y, fill = dB)) +
geom_text(aes(label = dB, x = x, y = y), size = 8) +
coord_fixed(ratio = 1) +
scale_fill_gradientn(colours = viridis(47), limits = c(-1, 46),
na.value="darkred") +
theme_bw() +
ggtitle(paste0("Retinalogik ", id, " Visit ", visit, " Eye: ", eye))
)
) %>%
# pull is the pipe-able equivalent of .[['graphs']]
pull(graphs) %>%
# Return the svg of graphs
map(function(gr) svglite::xmlSVG(show(gr), standalone = TRUE)) ->
rt_individual_graphs
# carousels
hfa_plots <- slickR(hfa_individual_graphs, height = 350, width = "95%", padding = 0, slideId = "slick3") +
settings(slidesToShow = 2, slidesToScroll = 2)
rt_plots <- slickR(rt_individual_graphs, height = 350, width = "95%", padding = 0, slideId = "slick4") +
settings(slidesToShow = 2, slidesToScroll = 2)
rt_plots %synch% hfa_plotsRL03
dBdat %>%
mutate(dB = as.numeric(dB)) %>%
filter(device == "hfa" & id == "RL03") %>%
group_by(id, visit, eye) %>%
arrange(id, visit, eye) %>%
# Use the group_by %>% nest pattern to group data by id
nest() %>%
# Use map2 so the id can be used as the title
mutate(graphs = map2(data, id,
~ggplot(data = .x, aes(x, y, dB)) +
geom_raster(aes(x = x, y = y, fill = dB)) +
geom_text(aes(label = dB, x = x, y = y), size = 8) +
coord_fixed(ratio = 1) +
scale_fill_gradientn(colours = viridis(47), limits = c(-1, 46),
na.value="darkred") +
theme_bw() +
ggtitle(paste0("HFA ", id, " Visit ", visit, " Eye: ", eye))
)
) %>%
# pull is the pipe-able equivalent of .[['graphs']]
pull(graphs) %>%
# Return the svg of graphs
map(function(gr) svglite::xmlSVG(show(gr), standalone = TRUE)) ->
hfa_individual_graphs
dBdat %>%
mutate(dB = as.numeric(dB)) %>%
filter(device == "retinalogik" & id == "RL03") %>%
group_by(id, visit, eye) %>%
arrange(id, visit, eye) %>%
# Use the group_by %>% nest pattern to group data by id
nest() %>%
# Use map2 so the id can be used as the title
mutate(graphs = map2(data, id,
~ggplot(data = .x, aes(x, y, dB)) +
geom_raster(aes(x = x, y = y, fill = dB)) +
geom_text(aes(label = dB, x = x, y = y), size = 8) +
coord_fixed(ratio = 1) +
scale_fill_gradientn(colours = viridis(47), limits = c(-1, 46),
na.value="darkred") +
theme_bw() +
ggtitle(paste0("Retinalogik ", id, " Visit ", visit, " Eye: ", eye))
)
) %>%
# pull is the pipe-able equivalent of .[['graphs']]
pull(graphs) %>%
# Return the svg of graphs
map(function(gr) svglite::xmlSVG(show(gr), standalone = TRUE)) ->
rt_individual_graphs
# carousels
hfa_plots <- slickR(hfa_individual_graphs, height = 350, width = "95%", padding = 0) +
settings(slidesToShow = 2, slidesToScroll = 2)
rt_plots <- slickR(rt_individual_graphs, height = 350, width = "95%", padding = 0) +
settings(slidesToShow = 2, slidesToScroll = 2)
rt_plots %synch% hfa_plots RL06
dBdat %>%
mutate(dB = as.numeric(dB)) %>%
filter(device == "hfa" & id == "RL06") %>%
group_by(id, visit, eye) %>%
arrange(id, visit, eye) %>%
# Use the group_by %>% nest pattern to group data by id
nest() %>%
# Use map2 so the id can be used as the title
mutate(graphs = map2(data, id,
~ggplot(data = .x, aes(x, y, dB)) +
geom_raster(aes(x = x, y = y, fill = dB)) +
geom_text(aes(label = dB, x = x, y = y), size = 8) +
coord_fixed(ratio = 1) +
scale_fill_gradientn(colours = viridis(47), limits = c(-1, 46),
na.value="darkred") +
theme_bw() +
ggtitle(paste0("HFA ", id, " Visit ", visit, " Eye: ", eye))
)
) %>%
# pull is the pipe-able equivalent of .[['graphs']]
pull(graphs) %>%
# Return the svg of graphs
map(function(gr) svglite::xmlSVG(show(gr), standalone = TRUE)) ->
hfa_individual_graphs
dBdat %>%
mutate(dB = as.numeric(dB)) %>%
filter(device == "retinalogik" & id == "RL06") %>%
group_by(id, visit, eye) %>%
arrange(id, visit, eye) %>%
# Use the group_by %>% nest pattern to group data by id
nest() %>%
# Use map2 so the id can be used as the title
mutate(graphs = map2(data, id,
~ggplot(data = .x, aes(x, y, dB)) +
geom_raster(aes(x = x, y = y, fill = dB)) +
geom_text(aes(label = dB, x = x, y = y), size = 8) +
coord_fixed(ratio = 1) +
scale_fill_gradientn(colours = viridis(47), limits = c(-1, 46),
na.value="darkred") +
theme_bw() +
ggtitle(paste0("Retinalogik ", id, " Visit ", visit, " Eye: ", eye))
)
) %>%
# pull is the pipe-able equivalent of .[['graphs']]
pull(graphs) %>%
# Return the svg of graphs
map(function(gr) svglite::xmlSVG(show(gr), standalone = TRUE)) ->
rt_individual_graphs
# carousels
hfa_plots <- slickR(hfa_individual_graphs, height = 350, width = "95%", padding = 0) +
settings(slidesToShow = 2, slidesToScroll = 2)
rt_plots <- slickR(rt_individual_graphs, height = 350, width = "95%", padding = 0) +
settings(slidesToShow = 2, slidesToScroll = 2)
rt_plots %synch% hfa_plots RL07
# make sure coordinates are numeric, then flip OS to OD for plotting purposes
dBdat %>%
mutate(dB = as.numeric(dB)) %>%
filter(device == "hfa" & id == "RL07") %>%
group_by(id, visit, eye) %>%
arrange(id, visit, eye) %>%
# Use the group_by %>% nest pattern to group data by id
nest() %>%
# Use map2 so the id can be used as the title
mutate(graphs = map2(data, id,
~ggplot(data = .x, aes(x, y, dB)) +
geom_raster(aes(x = x, y = y, fill = dB)) +
geom_text(aes(label = dB, x = x, y = y), size = 8) +
coord_fixed(ratio = 1) +
scale_fill_gradientn(colours = viridis(47), limits = c(-1, 46),
na.value="darkred") +
theme_bw() +
ggtitle(paste0("HFA ", id, " Visit ", visit, " Eye: ", eye))
)
) %>%
# pull is the pipe-able equivalent of .[['graphs']]
pull(graphs) %>%
# Return the svg of graphs
map(function(gr) svglite::xmlSVG(show(gr), standalone = TRUE)) ->
hfa_individual_graphs
dBdat %>%
mutate(dB = as.numeric(dB)) %>%
filter(device == "retinalogik" & id == "RL07") %>%
group_by(id, visit, eye) %>%
arrange(id, visit, eye) %>%
# Use the group_by %>% nest pattern to group data by id
nest() %>%
# Use map2 so the id can be used as the title
mutate(graphs = map2(data, id,
~ggplot(data = .x, aes(x, y, dB)) +
geom_raster(aes(x = x, y = y, fill = dB)) +
geom_text(aes(label = dB, x = x, y = y), size = 8) +
coord_fixed(ratio = 1) +
scale_fill_gradientn(colours = viridis(47), limits = c(-1, 46),
na.value="darkred") +
theme_bw() +
ggtitle(paste0("Retinalogik ", id, " Visit ", visit, " Eye: ", eye))
)
) %>%
# pull is the pipe-able equivalent of .[['graphs']]
pull(graphs) %>%
# Return the svg of graphs
map(function(gr) svglite::xmlSVG(show(gr), standalone = TRUE)) ->
rt_individual_graphs
# carousels
hfa_plots <- slickR(hfa_individual_graphs, height = 350, width = "95%", padding = 0) +
settings(slidesToShow = 1, slidesToScroll = 1)
rt_plots <- slickR(rt_individual_graphs, height = 350, width = "95%", padding = 0) +
settings(slidesToShow = 1, slidesToScroll = 1)
rt_plots %synch% hfa_plots RL08
# make sure coordinates are numeric, then flip OS to OD for plotting purposes
dBdat %>%
mutate(dB = as.numeric(dB)) %>%
filter(device == "hfa" & id == "RL08") %>%
group_by(id, visit, eye) %>%
arrange(id, visit, eye) %>%
# Use the group_by %>% nest pattern to group data by id
nest() %>%
# Use map2 so the id can be used as the title
mutate(graphs = map2(data, id,
~ggplot(data = .x, aes(x, y, dB)) +
geom_raster(aes(x = x, y = y, fill = dB)) +
geom_text(aes(label = dB, x = x, y = y), size = 8) +
coord_fixed(ratio = 1) +
scale_fill_gradientn(colours = viridis(47), limits = c(-1, 46),
na.value="darkred") +
theme_bw() +
ggtitle(paste0("HFA ", id, " Visit ", visit, " Eye: ", eye))
)
) %>%
# pull is the pipe-able equivalent of .[['graphs']]
pull(graphs) %>%
# Return the svg of graphs
map(function(gr) svglite::xmlSVG(show(gr), standalone = TRUE)) ->
hfa_individual_graphs
dBdat %>%
mutate(dB = as.numeric(dB)) %>%
filter(device == "retinalogik" & id == "RL08") %>%
group_by(id, visit, eye) %>%
arrange(id, visit, eye) %>%
# Use the group_by %>% nest pattern to group data by id
nest() %>%
# Use map2 so the id can be used as the title
mutate(graphs = map2(data, id,
~ggplot(data = .x, aes(x, y, dB)) +
geom_raster(aes(x = x, y = y, fill = dB)) +
geom_text(aes(label = dB, x = x, y = y), size = 8) +
coord_fixed(ratio = 1) +
scale_fill_gradientn(colours = viridis(47), limits = c(-1, 46),
na.value="darkred") +
theme_bw() +
ggtitle(paste0("Retinalogik ", id, " Visit ", visit, " Eye: ", eye))
)
) %>%
# pull is the pipe-able equivalent of .[['graphs']]
pull(graphs) %>%
# Return the svg of graphs
map(function(gr) svglite::xmlSVG(show(gr), standalone = TRUE)) ->
rt_individual_graphs
# carousels
hfa_plots <- slickR(hfa_individual_graphs, height = 350, width = "95%", padding = 0) +
settings(slidesToShow = 2, slidesToScroll = 2)
rt_plots <- slickR(rt_individual_graphs, height = 350, width = "95%", padding = 0) +
settings(slidesToShow = 2, slidesToScroll = 2)
rt_plots %synch% hfa_plots RL09
# make sure coordinates are numeric, then flip OS to OD for plotting purposes
dBdat %>%
mutate(dB = as.numeric(dB)) %>%
filter(device == "hfa" & id == "RL09") %>%
group_by(id, visit, eye) %>%
arrange(id, visit, eye) %>%
# Use the group_by %>% nest pattern to group data by id
nest() %>%
# Use map2 so the id can be used as the title
mutate(graphs = map2(data, id,
~ggplot(data = .x, aes(x, y, dB)) +
geom_raster(aes(x = x, y = y, fill = dB)) +
geom_text(aes(label = dB, x = x, y = y), size = 8) +
coord_fixed(ratio = 1) +
scale_fill_gradientn(colours = viridis(47), limits = c(-1, 46),
na.value="darkred") +
theme_bw() +
ggtitle(paste0("HFA ", id, " Visit ", visit, " Eye: ", eye))
)
) %>%
# pull is the pipe-able equivalent of .[['graphs']]
pull(graphs) %>%
# Return the svg of graphs
map(function(gr) svglite::xmlSVG(show(gr), standalone = TRUE)) ->
hfa_individual_graphs
dBdat %>%
mutate(dB = as.numeric(dB)) %>%
filter(device == "retinalogik" & id == "RL09") %>%
group_by(id, visit, eye) %>%
arrange(id, visit, eye) %>%
# Use the group_by %>% nest pattern to group data by id
nest() %>%
# Use map2 so the id can be used as the title
mutate(graphs = map2(data, id,
~ggplot(data = .x, aes(x, y, dB)) +
geom_raster(aes(x = x, y = y, fill = dB)) +
geom_text(aes(label = dB, x = x, y = y), size = 8) +
coord_fixed(ratio = 1) +
scale_fill_gradientn(colours = viridis(47), limits = c(-1, 46),
na.value="darkred") +
theme_bw() +
ggtitle(paste0("Retinalogik ", id, " Visit ", visit, " Eye: ", eye))
)
) %>%
# pull is the pipe-able equivalent of .[['graphs']]
pull(graphs) %>%
# Return the svg of graphs
map(function(gr) svglite::xmlSVG(show(gr), standalone = TRUE)) ->
rt_individual_graphs
# carousels
hfa_plots <- slickR(hfa_individual_graphs, height = 350, width = "95%", padding = 0) +
settings(slidesToShow = 2, slidesToScroll = 2)
rt_plots <- slickR(rt_individual_graphs, height = 350, width = "95%", padding = 0) +
settings(slidesToShow = 2, slidesToScroll = 2)
rt_plots %synch% hfa_plots RL10
# make sure coordinates are numeric, then flip OS to OD for plotting purposes
dBdat %>%
mutate(dB = as.numeric(dB)) %>%
filter(device == "hfa" & id == "RL10") %>%
group_by(id, visit, eye) %>%
arrange(id, visit, eye) %>%
# Use the group_by %>% nest pattern to group data by id
nest() %>%
# Use map2 so the id can be used as the title
mutate(graphs = map2(data, id,
~ggplot(data = .x, aes(x, y, dB)) +
geom_raster(aes(x = x, y = y, fill = dB)) +
geom_text(aes(label = dB, x = x, y = y), size = 8) +
coord_fixed(ratio = 1) +
scale_fill_gradientn(colours = viridis(47), limits = c(-1, 46),
na.value="darkred") +
theme_bw() +
ggtitle(paste0("HFA ", id, " Visit ", visit, " Eye: ", eye))
)
) %>%
# pull is the pipe-able equivalent of .[['graphs']]
pull(graphs) %>%
# Return the svg of graphs
map(function(gr) svglite::xmlSVG(show(gr), standalone = TRUE)) ->
hfa_individual_graphs
dBdat %>%
mutate(dB = as.numeric(dB)) %>%
filter(device == "retinalogik" & id == "RL10") %>%
group_by(id, visit, eye) %>%
arrange(id, visit, eye) %>%
# Use the group_by %>% nest pattern to group data by id
nest() %>%
# Use map2 so the id can be used as the title
mutate(graphs = map2(data, id,
~ggplot(data = .x, aes(x, y, dB)) +
geom_raster(aes(x = x, y = y, fill = dB)) +
geom_text(aes(label = dB, x = x, y = y), size = 8) +
coord_fixed(ratio = 1) +
scale_fill_gradientn(colours = viridis(47), limits = c(-1, 46),
na.value="darkred") +
theme_bw() +
ggtitle(paste0("Retinalogik ", id, " Visit ", visit, " Eye: ", eye))
)
) %>%
# pull is the pipe-able equivalent of .[['graphs']]
pull(graphs) %>%
# Return the svg of graphs
map(function(gr) svglite::xmlSVG(show(gr), standalone = TRUE)) ->
rt_individual_graphs
# carousels
hfa_plots <- slickR(hfa_individual_graphs, height = 350, width = "95%", padding = 0) +
settings(slidesToShow = 2, slidesToScroll = 2)
rt_plots <- slickR(rt_individual_graphs, height = 350, width = "95%", padding = 0) +
settings(slidesToShow = 2, slidesToScroll = 2)
rt_plots %synch% hfa_plots RL11
# make sure coordinates are numeric, then flip OS to OD for plotting purposes
dBdat %>%
mutate(dB = as.numeric(dB)) %>%
filter(device == "hfa" & id == "RL11") %>%
group_by(id, visit, eye) %>%
arrange(id, visit, eye) %>%
# Use the group_by %>% nest pattern to group data by id
nest() %>%
# Use map2 so the id can be used as the title
mutate(graphs = map2(data, id,
~ggplot(data = .x, aes(x, y, dB)) +
geom_raster(aes(x = x, y = y, fill = dB)) +
geom_text(aes(label = dB, x = x, y = y), size = 8) +
coord_fixed(ratio = 1) +
scale_fill_gradientn(colours = viridis(47), limits = c(-1, 46),
na.value="darkred") +
theme_bw() +
ggtitle(paste0("HFA ", id, " Visit ", visit, " Eye: ", eye))
)
) %>%
# pull is the pipe-able equivalent of .[['graphs']]
pull(graphs) %>%
# Return the svg of graphs
map(function(gr) svglite::xmlSVG(show(gr), standalone = TRUE)) ->
hfa_individual_graphs
dBdat %>%
mutate(dB = as.numeric(dB)) %>%
filter(device == "retinalogik" & id == "RL11") %>%
group_by(id, visit, eye) %>%
arrange(id, visit, eye) %>%
# Use the group_by %>% nest pattern to group data by id
nest() %>%
# Use map2 so the id can be used as the title
mutate(graphs = map2(data, id,
~ggplot(data = .x, aes(x, y, dB)) +
geom_raster(aes(x = x, y = y, fill = dB)) +
geom_text(aes(label = dB, x = x, y = y), size = 8) +
coord_fixed(ratio = 1) +
scale_fill_gradientn(colours = viridis(47), limits = c(-1, 46),
na.value="darkred") +
theme_bw() +
ggtitle(paste0("Retinalogik ", id, " Visit ", visit, " Eye: ", eye))
)
) %>%
# pull is the pipe-able equivalent of .[['graphs']]
pull(graphs) %>%
# Return the svg of graphs
map(function(gr) svglite::xmlSVG(show(gr), standalone = TRUE)) ->
rt_individual_graphs
# carousels
hfa_plots <- slickR(hfa_individual_graphs, height = 350, width = "95%", padding = 0) +
settings(slidesToShow = 2, slidesToScroll = 2)
rt_plots <- slickR(rt_individual_graphs, height = 350, width = "95%", padding = 0) +
settings(slidesToShow = 2, slidesToScroll = 2)
rt_plots %synch% hfa_plots RL12
# make sure coordinates are numeric, then flip OS to OD for plotting purposes
dBdat %>%
mutate(dB = as.numeric(dB)) %>%
filter(device == "hfa" & id == "RL12") %>%
group_by(id, visit, eye) %>%
arrange(id, visit, eye) %>%
# Use the group_by %>% nest pattern to group data by id
nest() %>%
# Use map2 so the id can be used as the title
mutate(graphs = map2(data, id,
~ggplot(data = .x, aes(x, y, dB)) +
geom_raster(aes(x = x, y = y, fill = dB)) +
geom_text(aes(label = dB, x = x, y = y), size = 8) +
coord_fixed(ratio = 1) +
scale_fill_gradientn(colours = viridis(47), limits = c(-1, 46),
na.value="darkred") +
theme_bw() +
ggtitle(paste0("HFA ", id, " Visit ", visit, " Eye: ", eye))
)
) %>%
# pull is the pipe-able equivalent of .[['graphs']]
pull(graphs) %>%
# Return the svg of graphs
map(function(gr) svglite::xmlSVG(show(gr), standalone = TRUE)) ->
hfa_individual_graphs
dBdat %>%
mutate(dB = as.numeric(dB)) %>%
filter(device == "retinalogik" & id == "RL12") %>%
group_by(id, visit, eye) %>%
arrange(id, visit, eye) %>%
# Use the group_by %>% nest pattern to group data by id
nest() %>%
# Use map2 so the id can be used as the title
mutate(graphs = map2(data, id,
~ggplot(data = .x, aes(x, y, dB)) +
geom_raster(aes(x = x, y = y, fill = dB)) +
geom_text(aes(label = dB, x = x, y = y), size = 8) +
coord_fixed(ratio = 1) +
scale_fill_gradientn(colours = viridis(47), limits = c(-1, 46),
na.value="darkred") +
theme_bw() +
ggtitle(paste0("Retinalogik ", id, " Visit ", visit, " Eye: ", eye))
)
) %>%
# pull is the pipe-able equivalent of .[['graphs']]
pull(graphs) %>%
# Return the svg of graphs
map(function(gr) svglite::xmlSVG(show(gr), standalone = TRUE)) ->
rt_individual_graphs
# carousels
hfa_plots <- slickR(hfa_individual_graphs, height = 350, width = "95%", padding = 0) +
settings(slidesToShow = 2, slidesToScroll = 2)
rt_plots <- slickR(rt_individual_graphs, height = 350, width = "95%", padding = 0) +
settings(slidesToShow = 2, slidesToScroll = 2)
rt_plots %synch% hfa_plots Global sensitivity indices
Bland–Altman analysis for mean deviation (top) and pattern standard deviation (bottom) comparing HFA and Retinalogik. The red solid line indicates the mean bias, the black dashed lines indicate the 95% limits of agreement, the blue solid line indicates the regression line and the black solid line indicates y = 0. For both panels, a more positive value indicates that the HFA returned a higher result, while a negative value indicates that the Retinalogik returned a higher result.
library(BlandAltmanLeh)
mdpsd <- dBdat %>%
distinct(id, age, visit, device, eye, md, psd) %>%
pivot_wider(names_from = device,
values_from = c(md, psd))
#####
# FOR SCREENING USE
# Average MDs
#####
# tmp <- dBdat %>%
# group_by(id) %>%
# filter(visit >= 3) %>% # Keep only ids with more than 3 visits
# ungroup()
#
# dBdat %>%
# filter(id == "RL07" & device == "hfa") %>% # Keep only ids with more than 3 visits
# distinct(id, visit, eye, md)
# dBdat %>%
# filter(device == "hfa") %>%
# group_by(id, eye) %>%
# summarise(mean_md = round(mean(md, na.rm = TRUE), 2), visits = max(visit)) %>%
# pivot_wider(names_from = eye, values_from = mean_md) %>%
# clipr::write_clip()
#####
p <- bland.altman.plot(mdpsd$md_hfa, mdpsd$md_retinalogik, graph.sys = "ggplot2")
meanbias <- mean(mdpsd$md_hfa, na.rm=T) - mean(mdpsd$md_retinalogik)
p1 <- print(p + geom_smooth(method = "lm", se = FALSE) +
geom_hline(yintercept = 0, color = "black") +
geom_hline(yintercept = meanbias, color = "red", linetype = "solid", size = 2) +
annotate("text", x = -17, y = -2, label=paste("Mean bias =", round(meanbias, 2), "dB")) +
xlab("Mean deviation (MD)") +
ylab("Difference in mean deviation (dB)") +
ggtitle("Bland-Altman plots (HFA-Retinalogik)"))
> `geom_smooth()` using formula = 'y ~ x'
p <- bland.altman.plot(mdpsd$psd_hfa, mdpsd$psd_retinalogik, graph.sys = "ggplot2")
meanbias <- mean(mdpsd$psd_hfa, na.rm=T) - mean(mdpsd$psd_retinalogik)
p2 <- print(p + geom_smooth(method = "lm", se = FALSE) +
geom_hline(yintercept = 0, color = "black") +
geom_hline(yintercept = meanbias, color = "red", linetype = "solid", size=2) +
annotate("text", x = 11, y = 1, label=paste("Mean bias =", round(meanbias, 2), "dB")) +
xlab("Pattern standard deviation (PSD)") + ylab("Difference in pattern standard deviation (dB)"))
> `geom_smooth()` using formula = 'y ~ x'
# grid.arrange(p1, p2, ncol=2, top = "Bland-Altman plots")
dBdat %>%
distinct(id, age, visit, device, eye, md, psd) %>%
datatable(extensions = 'Buttons', options = list(
dom = 'Bfrtip',
buttons =
list('copy', 'print', list(
extend = 'collection',
buttons = c('csv', 'excel', 'pdf'),
text = 'Download'
))
))Test duration comparison
duration <- dBdat %>%
group_by(device) %>%
mutate(mean = mean(as.duration(duration)), sd = sd(as.duration(duration))) %>%
distinct(device, mean, sd)
rtduration <- dBdat %>%
filter(device=="retinalogik") %>%
distinct(id, visit, eye, duration)
hfaduration <- dBdat %>%
filter(device=="hfa") %>%
distinct(id, visit, eye, duration)
# t.test(as.numeric(rtduration$duration), as.numeric(hfaduration$duration), paired=T)
Test duration were extracted for analysis. The mean test duration time was 3.82 (0.72) mins for Retinalogik and 5.55 (1.21) mins for HFA (insert p-value from paired t-test when all arguments have same length).
Scatterplots
widedat <- dBdat %>%
select(id, device, visit, eye, x, y, dB) %>%
pivot_wider(., names_from = device, values_from = dB) %>%
# mutate(retinalogik = ifelse(retinalogik == "<0", "-1", retinalogik)) %>%
mutate(retinalogik = as.numeric(retinalogik), hfa = as.numeric(hfa)) %>%
na.omit()
scatterplot <- widedat %>%
ggplot(., aes(x=hfa, y=retinalogik)) +
geom_point(aes(color=id), position = "jitter") +
geom_smooth(method = "loess") +
scale_x_continuous(breaks = seq(0, 44, by=2), limits=c(-1,40)) +
scale_y_continuous(breaks = seq(0, 44, by=2), limits=c(-1,40)) +
geom_abline(intercept = 0, slope = 1, color = "gray50") +
labs(title="Pointwise sensitivity for all visits and both eyes if available") +
xlab("HFA (dB)") +
ylab("Retinalogik (dB)") +
theme_bw()
ggplotly(scatterplot)
> `geom_smooth()` using formula = 'y ~ x'Discussion
Data
For those interested in the cleaned up pointwise data.
dBdat %>%
select(id, age, device, eye, x, y, dB) %>%
datatable(options = list(
order = list(1, 'asc')
))Report by Vivian Eng